home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 1463.ZIP / DRAW-2D.ARC / SKALE.PAS < prev    next >
Pascal/Delphi Source File  |  1986-12-03  |  4KB  |  121 lines
  1. PROCEDURE SKALE;
  2.    VAR
  3.      FACT,XREF,YREF:REAL;
  4.      FLAG:BOOLEAN;
  5.      KODE,K:INTEGER;
  6.      MSG:SCRLINE;
  7.    BEGIN
  8.      MOVCUR(24,2);
  9.      WRITE('Select Reference Point & press Left button (Right button for 0,0) >');
  10.      RING(1);
  11.      FLAG := FALSE;
  12.      WHILE NOT(FLAG) DO
  13.        BEGIN
  14.         GETMOUSE(X,Y,PIXX,PIXY,OPTION);
  15.         IF (BUTTON1) OR (BUTTON2) THEN FLAG := TRUE;
  16.         IF (BUTTON1) AND (OPTION <> 0) THEN
  17.            BEGIN
  18.              FLAG := FALSE;
  19.              RING2;
  20.              MOVCUR(24,1);
  21.              WRITE(BLKLINE);
  22.              MOVCUR(24,2);
  23.              WRITE('Move mouse cursor into graphics area!!');
  24.            END;
  25.        END;
  26.      IF BUTTON1 THEN
  27.         BEGIN
  28.           M1 := 2;
  29.           MOUSE(M1,M2,M3,M4);          (* HIDE MOUSE *)
  30.           MARK(PIXX,PIXY,HRCOLOR);
  31.           M1 := 1;                     (* SHOW MOUSE *)
  32.           MOUSE(M1,M2,M3,M4);
  33.           XREF := X;
  34.           YREF := Y;
  35.         END
  36.         ELSE
  37.         BEGIN
  38.           XREF := 0.0;
  39.           YREF := 0.0;
  40.         END;
  41.      MSG := 'Enter Scale Factor <1.0>: ';
  42.      FACT := ASKREAL(24,2,MSG,0.0,0.0,1.0);
  43.      PUSHID(KODE);
  44.      TRANSLAT(-XREF,-YREF,KODE);
  45.      SCALE(FACT,FACT,KODE);
  46.      TRANSLAT(XREF,YREF,KODE);
  47.      CASE MNUM OF
  48.      1: BEGIN         (* ENTIRE DRAWING *)
  49.           FOR K := 1 TO OBJPTR-1 DO
  50.            WITH DRAWARY[K] DO
  51.             BEGIN
  52.                CASE OBJTYP OF
  53.             1: MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (*  POINT  *)
  54.             2: BEGIN                                (*  LINE   *)
  55.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  56.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  57.                END;
  58.             3: BEGIN                                (*  BOX  *)
  59.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  60.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  61.                  MODVEC(X3,Y3,STKMAT[STKPTR-1]);
  62.                END;
  63.             4: BEGIN
  64.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (* CIRCLE *)
  65.                  X2 := X2 * FACT;
  66.                END;
  67.               END; (* CASE *)
  68.             END; (*WITH*)
  69.         END;
  70.      2: BEGIN         (* AREA *)
  71.           FOR K := 1 TO OBJPTR-1 DO
  72.            WITH DRAWARY[K] DO
  73.             BEGIN
  74.               IF OBJSEL = 1 THEN
  75.                CASE OBJTYP OF
  76.             1: MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (*  POINT  *)
  77.             2: BEGIN                                (*  LINE   *)
  78.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  79.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  80.                END;
  81.             3: BEGIN                                (*  BOX  *)
  82.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  83.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  84.                  MODVEC(X3,Y3,STKMAT[STKPTR-1]);
  85.                END;
  86.             4: BEGIN
  87.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (* CIRCLE *)
  88.                  X2 := X2 * FACT;
  89.                END;
  90.               END; (* CASE *)
  91.             END; (*WITH*)
  92.         END;
  93.      3: BEGIN         (* SINGLE OBJECT *)
  94.            WITH DRAWARY[SELNUM] DO
  95.             BEGIN
  96.                CASE OBJTYP OF
  97.             1: MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (*  POINT  *)
  98.             2: BEGIN                                (*  LINE   *)
  99.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  100.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  101.                END;
  102.             3: BEGIN                                (*  BOX  *)
  103.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  104.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  105.                  MODVEC(X3,Y3,STKMAT[STKPTR-1]);
  106.                END;
  107.             4: BEGIN
  108.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (* CIRCLE *)
  109.                  X2 := X2 * FACT;
  110.                END;
  111.               END; (* CASE *)
  112.             END; (*WITH*)
  113.         END;
  114.        END; (* CASE *)
  115.      POPMAT(KODE);
  116.      M1 := 2;
  117.      MOUSE(M1,M2,M3,M4);          (* HIDE MOUSE *)
  118.      REDRAW;
  119.      M1 := 1;                     (* SHOW MOUSE *)
  120.      MOUSE(M1,M2,M3,M4);
  121.   END; (*PROC*)